home *** CD-ROM | disk | FTP | other *** search
/ Aminet 15 / Aminet 15 - Nov 1996.iso / Aminet / dev / basic / ace24dist.lha / ace24.lha / prgs / Fractals / FractalTree.b next >
Text File  |  1996-09-10  |  3KB  |  142 lines
  1. ' Realistic Fractal Trees
  2. ' By John Grillo
  3. ' Copyright 1985
  4. ' by MicroSPARC, Inc.
  5. ' (in Nibble Mac magazine, Jan/Feb 1986)
  6. ' Converted from MS Mac BASIC to ACE Amiga BASIC
  7. ' by David Benn, December 1994
  8.  
  9. DEFINT a-z : CONST n=1200
  10. DIM a!(n), L(n)   'Branch angles AND lengths
  11. DIM px(n), py(n)  'Branch END-points
  12.  
  13. RANDOMIZE TIMER
  14.  
  15. DECLARE SUB InitMenu
  16.  
  17. SCREEN 1,640,400,2,4
  18. WINDOW 1,"Fractal Trees",(0,0)-(640,400),2,1
  19.  
  20. GOSUB StartVals
  21. InitMenu
  22.  
  23. ON MENU GOSUB MenuEvent
  24. MENU ON
  25.  
  26. Loop:
  27.   IF Done=1 THEN Loop
  28.   MENU 5,1,0
  29.   MENU 5,2,1
  30.   MENU 5,3,0
  31.   n1=1 : n2=1 : k=1  'n1 is loop start, n2 is loop END, k is counter
  32.   b=1  'number of branches from any given node
  33.   a!(1)=1.57+(px(1)-256)/400  'a! is a branch's starting angle
  34.   GOSUB DrawTrunk
  35.   GOSUB DrawTree
  36.   Done = 1
  37.   MENU 5,1,1
  38.   MENU 5,2,0
  39.   MENU 5,3,1
  40. GOTO Loop
  41.  
  42. MenuEvent:
  43.   MenuId = MENU(0) : ItemId = MENU(1)
  44.   IF MenuId=5 AND ItemId=1 THEN Done=0
  45.   IF MenuId=5 AND ItemId=2 THEN Done=1 : RETURN
  46.   IF MenuId=1 THEN px(1)=ItemId*100-50 : MaxItems = 5 : GOSUB ClrMenu
  47.   IF MenuId=2 THEN an!=ItemId*.2+RND/10 : MaxItems = 3 : GOSUB ClrMenu
  48.   IF MenuId=3 THEN pct!=1.25-.25*ItemId : MaxItems = 5 : GOSUB ClrMenu
  49.   IF MenuId=4 AND ItemId=3 THEN fib!=.618 : MaxItems = 5 : GOSUB ClrMenu
  50.   IF MenuId=4 AND ItemId<>3 THEN fib!=.1*ItemId+.3 : MaxItems = 5 : GOSUB ClrMenu
  51.   IF MenuId=5 AND ItemId=4 THEN WINDOW CLOSE 1 : SCREEN CLOSE 1 : END
  52.   IF MenuId=5 AND ItemId=3 THEN CLS
  53. RETURN
  54.  
  55. StartVals:
  56.   px(1)=320 : py(1)=240
  57.   an!=.4+RND*.1
  58.   L(1)=120
  59.   MinLen=2  'No more growth IF length < MinLen
  60.   fib!=.618 : thk=20 : pct!=.5
  61.   Done=1
  62. RETURN
  63.  
  64. DrawTrunk:
  65.   LINE (320,400)-(px(1),py(1))
  66. RETURN
  67.  
  68. DrawTree:
  69.   n1=n2 : n2=k  'redefine start, END of loop
  70.   IF n1=n2 AND k>1 THEN RETURN  'no limbs ON last pass
  71.   IF k>2 THEN n1=n1+1  'skip repeats
  72.   FOR i=n1 TO n2
  73.     GOSUB DrawLimbs
  74.     IF Done=1 THEN i=n2
  75.   NEXT i
  76.   IF k<N THEN DrawTree  'REPEAT this process UNTIL max # nodes
  77. RETURN
  78.  
  79. DrawLimbs:
  80.   IF i>n THEN Done=1 : RETURN
  81.   IF L(i)<MinLen THEN RETURN  'don't draw branch ON smallest limbs
  82.   FOR j=-b TO b  'set up loop FOR each limb at ith tip
  83.     IF j<>0 OR RND>pct! THEN GOSUB DrawBranch
  84.     IF Done=1 THEN j=b/2
  85.   NEXT j
  86. RETURN
  87.  
  88. DrawBranch:
  89.  k=k+1 : rand!=an!*RND-an!/2
  90.  IF k>n THEN RETURN  'More nodes than allowed
  91.  a!(k)=a!(i)+j*an!+rand!  'Define angle FOR this branch. Notice that when
  92.                'b is 2, j is -1, 0 or 1, so branch will go left,
  93.               'straight or right.
  94.  L(k)=fib!*L(i)+rand!*thk  'define NEW length
  95.  IF j=0 THEN L(k)=L(k)*(1+rand!)  'make center limb a bit longer
  96.  px(k)=px(i)+INT(L(k)*COS(a!(k)))
  97.  py(k)=py(i)-INT(L(k)*SIN(a!(k)))
  98.  IF Done=1 THEN RETURN
  99.  LINE (px(i),py(i))-(px(k),py(k))
  100. RETURN
  101.  
  102. ClrMenu:
  103.   FOR Item=1 TO MaxItems
  104.     MENU MenuId,Item,1
  105.   NEXT Item
  106.   MENU MenuId,ItemId,2
  107. RETURN
  108.  
  109. SUB InitMenu
  110.   MENU 1,0,1,"  Position"
  111.   MENU 1,1,1,"  Far left"
  112.   MENU 1,2,1,"  Left"
  113.   MENU 1,3,2,"  Center"
  114.   MENU 1,4,1,"  Right"
  115.   MENU 1,5,1,"  Far right"
  116.  
  117.   MENU 2,0,1,"  Angle"
  118.   MENU 2,1,1,"  Small"
  119.   MENU 2,2,2,"  Medium"
  120.   MENU 2,3,1,"  Large"
  121.  
  122.   MENU 3,0,1,"  Center br."
  123.   MENU 3,1,1,"  None"
  124.   MENU 3,2,1,"  Occasional"
  125.   MENU 3,3,2,"  Moderate"
  126.   MENU 3,4,1,"  Frequent"
  127.   MENU 3,5,1,"  Always"
  128.  
  129.   MENU 4,0,1,"  Length"
  130.   MENU 4,1,1,"  .4"
  131.   MENU 4,2,1,"  .5"
  132.   MENU 4,3,2,"  .618"
  133.   MENU 4,4,1,"  .7"
  134.   MENU 4,5,1,"  .8"
  135.  
  136.   MENU 5,0,1,"Trees"
  137.   MENU 5,1,1,"Draw tree"
  138.   MENU 5,2,0,"Stop drawing"
  139.   MENU 5,3,1,"Clear screen"
  140.   MENU 5,4,1,"Quit","Q"
  141. END SUB
  142.